home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS08.ADF / AmigaBasicProgs / Spelling (.txt) < prev    next >
AmigaBASIC Source Code  |  1986-04-02  |  4KB  |  157 lines
  1.  
  2. ' title
  3.  
  4. SCREEN 1,320,200,4,1: WINDOW 2, "Spelling", (0,0)-(310,186), 0, 1
  5. WINDOW OUTPUT 2: CLS: PRINT " " : DIM SHARED PCan!(31,3)
  6. CALL SetRGB (0,0,0,0):  CALL SetRGB(1,15,15,15):CALL SetRGB(2,15,0,0)
  7. CALL SetRGB (3,15,10,0):CALL SetRGB(4,0,0,0):   CALL SetRGB(15,0,0,0)
  8. LINE(68,6)-(240,166),2,bf
  9. LINE(14,14)-(153,40),3,bf
  10. LINE(166,136)-(288,158),3,bf
  11. COLOR 1,2
  12. LOCATE 9,11: PRINT"Created exclusively";
  13. LOCATE 11,19:PRINT "for";
  14. LOCATE 13,12:PRINT "Slipped Disk Inc."
  15. COLOR 1,3
  16. LOCATE 4,4: PRINT"S P E L L I N G"
  17. LOCATE 19,23: PRINT"Robert Sawdey"
  18. CALL SetRGB( 4,15,15,2)
  19. FOR i=1 TO 5000:NEXT
  20. FOR j%=0 TO 15
  21.   FOR i%=0 TO 3
  22.     CALL AskRGB( i%,r%,g%,b%)
  23.     IF r%>0 THEN r%=r%-1
  24.     IF g%>0 THEN g%=g%-1
  25.     IF b%>0 THEN b%=b%-1
  26.     CALL SetRGB( i%, r%, g%, b%)
  27.   NEXT i%: 
  28. NEXT j%
  29. '
  30. '     setup screen & stripes
  31. '
  32. CLS
  33. FOR i%=2 TO 15
  34. COLOR i%
  35. LINE (0,i%*12-15)-(319,i%*12-3),,bf
  36. NEXT i%
  37. COLOR 0,1 :'   foreground pen , background pen
  38. '
  39. LINE(45,82)-(187,116),,bf
  40.  
  41. CALL SetRGB( 0,10,0,12):' screen color
  42. CALL SetRGB( 1,15,15,10):'  text color
  43. CALL SetRGB( 2,15,10,15):' border color
  44. CALL SetRGB( 3,15,0,15)
  45. CALL SetRGB( 4,15,0,10)
  46. CALL SetRGB( 5,15,0,5)
  47. CALL SetRGB( 6,15,0,0)
  48. CALL SetRGB( 7,10,0,5)
  49. CALL SetRGB( 8,5,0,10)
  50. CALL SetRGB( 9,0,0,15)
  51. CALL SetRGB( 10,0,5,10)
  52. CALL SetRGB( 11,0,10,5)
  53. CALL SetRGB( 12,5,15,5)
  54. CALL SetRGB( 13,10,15,5)
  55. CALL SetRGB( 14,15,15,5)
  56. CALL SetRGB( 15,15,15,10)
  57.  
  58. '
  59. '    setup voice parameters
  60. '
  61. a%(0)=220   :' pitch(65-320)
  62. a%(1)=0     :' inflect(0-1)
  63. a%(2)=120   :' rate(40-400)
  64. a%(3)=1     :' 0=male 1=fem
  65. a%(4)=27500 :'tuning 5k-28k
  66. a%(5)=64    :' volume(0-64)
  67. a%(6)=10    :'channel(0-11)
  68. a%(7)=1     :' mode(0-1)
  69. a%(8)=0     :' control(0-2)
  70. '
  71. ' student name & word list
  72. '
  73. b$(0)="student"
  74. b$(1)="hi"
  75. b$(2)="boy"
  76. b$(3)="bus"
  77. b$(4)="run"
  78. b$(5)="sun"
  79. b$(6)="tag"
  80. b$(7)="mom"
  81. b$(8)="bug"
  82. b$(9)="daddy"
  83. b$(10)="girl"
  84. '
  85. '    intro
  86. '
  87.    PRINT" Spelling Quiz: Type <return> to quit"
  88.    a$="Please type your name.":GOSUB talk
  89.    LOCATE 13,8: PRINT "";:INPUT;b$(0)
  90.    IF b$(0)="" THEN GOTO quit
  91.    a$="Hello "+b$(0)+". Lets spell.":l%=0:GOSUB talk
  92.    '
  93.    '     main test loop
  94.    '
  95. right:
  96.    l%=l%+1
  97. wrong:
  98.    IF l%>10 THEN GOTO congrats
  99.    a$="Please type. "+b$(l%)+"."
  100.    GOSUB talk
  101.    LOCATE 13,8: PRINT "               "
  102.    LOCATE 13,8: PRINT "";:INPUT; a$
  103.    IF a$="" THEN GOTO quit
  104.    IF a$=b$(l%) THEN a$="you got it right.":GOSUB talk:GOSUB cycle:GOTO right
  105.    IF a$<>b$(l%) THEN a$="try again.":GOSUB talk:GOTO wrong
  106.    '
  107.    '  speakit
  108.    '
  109. talk:
  110.    b$=TRANSLATE$(a$)
  111.    SAY b$, a%
  112.    RETURN
  113.    '
  114.    '  congrats
  115.    '
  116. congrats:
  117.    GOSUB cycle:a$="now you are done.":GOSUB talk
  118.    a$="you have spelled all ten words right.":GOSUB talk:GOTO quit
  119.    '
  120.    ' roll colors
  121.    '
  122. cycle:
  123.   FOR j%=15 TO 0 STEP -1
  124.     FOR i%= 2 TO 15
  125.       PALETTE ((i%+j%) MOD 13)+2, PCan!( i%,0), PCan!( i%,1), PCan!( i%,2)
  126.     NEXT i%
  127.   NEXT j%
  128.   RETURN
  129.   '
  130.   ' Clean up & go home
  131.   '
  132.   ' reset rgb
  133. quit:
  134.   CALL SetRGB( 0,6,9,15):   CALL SetRGB( 1,0,0,0)
  135.   CALL SetRGB( 2,15,15,15): CALL SetRGB( 3,15,9,10)
  136.   CALL SetRGB( 4,14,3,0):   CALL SetRGB( 5 ,15,11,0)
  137.   CALL SetRGB( 6,15,15,2):  CALL SetRGB( 7,11,15,0)
  138.   CALL SetRGB( 8,5,13,0):   CALL SetRGB( 9,0,14,13)
  139.   CALL SetRGB( 10,7,13,15): CALL SetRGB( 11,12,0,14)
  140.   CALL SetRGB( 12,15,2,14): CALL SetRGB( 13,15,13,11)
  141.   CALL SetRGB( 14,12,9,8) : CALL SetRGB( 15,11,11,11)
  142.   CLS:PRINT " ":WINDOW CLOSE 2: SCREEN CLOSE 1
  143.   
  144. SUB AskRGB( n%, r%, g%, b%)  STATIC
  145.   r% = PCan!( n%, 0) * 15
  146.   g% = PCan!( n%, 1) * 15
  147.   b% = PCan!( n%, 2) * 15
  148. END SUB
  149.  
  150. SUB SetRGB( n%, r%, g%, b%)  STATIC
  151.   PCan!( n%, 0) = r% /15
  152.   PCan!( n%, 1) = g% /15
  153.   PCan!( n%, 2) = b% /15
  154.   PALETTE n%, PCan!( n%,0), PCan!( n%,1), PCan!( n%,2)
  155. END SUB
  156.   
  157.